home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
archiver
/
ldiff12s.zip
/
LDPROC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-07-15
|
11KB
|
470 lines
(*---------------------------------------------------------------------------*)
(*LDProc.pas ékécé`éÆéâùpè╓Éö (C) ÄOû╪ÿaòF NIFTY SDR SDI00147 1989/7/1 *)
(*$B-,F-,I-,N- *)
(*---------------------------------------------------------------------------*)
UNIT LDProc;
INTERFACE
USES
Dos,
MyType,
MyTool,
LDVari;
PROCEDURE ReadDic (VAR fs:LONGINT);
PROCEDURE BlkClose (VAR f:BFILE);
PROCEDURE BlkCopy (VAR fdi,fdo:BFILE;size:LONGINT);
PROCEDURE BlkERase (VAR f:BFILE);
FUNCTION BlkFilePos (VAR f:BFILE):LONGINT;
FUNCTION BlkFileSize (VAR f:BFILE):LONGINT;
FUNCTION BlkOpen (VAR f:BFILE;modes:STRING;s:PathStr):BOOLEAN;
FUNCTION BlkRead (VAR f:BFILE;VAR mem;cnt:WORD):WORD;
PROCEDURE BlkSeek (VAR f:BFILE;pnt:LONGINT);
PROCEDURE BlkWrite (VAR f:BFILE;VAR mem;cnt:WORD);
PROCEDURE Error (s:STRING;n:BYTE);
PROCEDURE FReName (s1,s2:STRING);
PROCEDURE GetBAttr (VAR f:BFILE;VAR attr:WORD);
PROCEDURE GetBTime (VAR f:BFILE;VAR time:LONGINT);
FUNCTION MEG (n:BYTE):STRING;
PROCEDURE Msg (s:STRING);
PROCEDURE MsgLn (s:STRING);
FUNCTION ReadHdr (VAR f:BFILE):BOOLEAN;
FUNCTION ChkHdr (VAR f:BFILE):BOOLEAN;
FUNCTION SkipArcHdr (VAR f:BFILE):BOOLEAN;
PROCEDURE SetBAttr (VAR f:BFILE;attr:WORD);
PROCEDURE SetBTime (VAR f:BFILE;time:LONGINT);
PROCEDURE TxtCopy (VAR fdi,fdo:BFILE;size:LONGINT);
FUNCTION YesNo (s:STRING):BOOLEAN;
IMPLEMENTATION
FUNCTION MEG; EXTERNAL;{$L MEG.OBJ}
FUNCTION BlkReadCrc(VAR f:BFILE;VAR mem;size:WORD):WORD;
VAR
buf : array[1..$8000] OF BYTE ABSOLUTE mem;
i : WORD;
BEGIN
size:=BlkRead(f,mem,size);
FOR i:=1 TO size DO CRC:=Hi(CRC) XOR CrcTable[Lo(CRC) XOR buf[i]];
BlkReadCrc:=size;
END;
PROCEDURE ReadDic(VAR fs:LONGINT);
BEGIN
IF NOT BlkOpen(OldFVar,'I',OldFName) THEN Error(OldFName,CantOpenErMsg);
CRC:=0;
New(DicBuf);
New(DicBuf2);
New(DicBuf3);
New(DicBuf4);
DicSeg:=Seg(DicBuf^);
IF BlkReadCrc(OldFVar,DicBuf^ ,$8000)=$8000 THEN
IF BlkReadCrc(OldFVar,DicBuf2^,$8000)=$8000 THEN
IF BlkReadCrc(OldFVar,DicBuf3^,$8000)=$8000 THEN
IF BlkReadCrc(OldFVar,DicBuf4^,$8000)=$8000 THEN BEGIN
New(DicBuf5);
IF BlkReadCrc(OldFVar,DicBuf5^,$8000)=$8000 THEN BEGIN
New(DicBuf6);
IF BlkReadCrc(OldFVar,DicBuf6^,$8000)=$8000 THEN BEGIN
New(DicBuf7);
IF BlkReadCrc(OldFVar,DicBuf7^,$8000)=$8000 THEN BEGIN
New(DicBuf8);
IF BlkReadCrc(OldFVar,DicBuf8^,$8000)=$8000 THEN ;
END;
END;
END;
END;
fs:=BlkFileSize(OldFVar);
BlkClose(OldFVar);
END;
FUNCTION BlkRead(VAR f:BFILE;VAR mem;cnt:WORD):WORD;
BEGIN
WITH Regs,f DO BEGIN
AH:=$3F;
DS:=Seg(mem);
DX:=Ofs(mem);
CX:=cnt;
BX:=Handle;
MsDos(Regs);
IF (Flags AND FCarry)<>0 THEN Error(AscZ(f.Name),ReadingErMsg)
ELSE BlkRead:=AX;
END;
END;
PROCEDURE BlkWrite(VAR f:BFILE;VAR mem;cnt:WORD);
BEGIN
WITH Regs,f DO BEGIN
AH:=$40;
DS:=Seg(mem);
DX:=Ofs(mem);
CX:=cnt;
BX:=Handle;
MsDos(Regs);
IF (Flags AND FCarry)<>0 THEN BEGIN
BlkClose(f);
BlkErase(f);
Error(AscZ(f.Name),WritingErMsg);END
ELSE IF AX<>CX THEN BEGIN
BlkClose(f);
BlkErase(f);
Error(AscZ(f.Name),DiskFullErMsg);
END;
END;
END;
PROCEDURE BlkSeek(VAR f:BFILE;pnt:LONGINT);
BEGIN
WITH Regs,f DO BEGIN
AX:=$4200;
CX:=WORD((pnt AND $FFFF0000) SHR 16);
DX:=WORD(pnt);
BX:=Handle;
MsDos(Regs);
END;
END;
PROCEDURE FReName(s1,s2:STRING);
BEGIN
s1:=s1+NUL;
s2:=s2+NUL;
WITH Regs DO BEGIN
AX:=$5600;
DS:=Seg(s1);
DX:=Ofs(s1[1]);
ES:=Seg(s2);
DI:=Ofs(s2[1]);
MsDos(Regs);
END;
END;
FUNCTION BlkFilePos(VAR f:BFILE):LONGINT;
BEGIN
WITH Regs,f DO BEGIN
AX:=$4201;
CX:=0;
DX:=0;
BX:=Handle;
MsDos(Regs);
BlkFilePos:=(LONGINT(DX) SHL 16)+AX;
END;
END;
FUNCTION BlkFileSize(VAR f:BFILE):LONGINT;
VAR
tmp : LONGINT;
BEGIN
tmp:=BlkFilePos(f);
WITH Regs,f DO BEGIN
AX:=$4202;
CX:=0;
DX:=0;
BX:=Handle;
MsDos(Regs);
BlkFileSize:=(LONGINT(DX) SHL 16)+AX;END;
BlkSeek(f,tmp);
END;
PROCEDURE BlkClose(VAR f:BFILE);
BEGIN
WITH Regs,f DO BEGIN
AH:=$3E;
BX:=Handle;
MsDos(Regs);
OpenFlg:=FALSE;
END;
END;
PROCEDURE BlkERase(VAR f:BFILE);
VAR
savedir : PathStr;
BEGIN
GetDir(0,savedir);
WITH Regs,f DO BEGIN
ChDir(Path);
AH:=$41;
DS:=Seg(Name);
DX:=Ofs(Name);
MsDos(Regs);END;
ChDir(savedir);
END;
PROCEDURE BlkCopy(VAR fdi,fdo:BFILE;size:LONGINT);
CONST
maxbuf = $2000;
VAR
buf : array[1..maxbuf] OF BYTE;
BEGIN
WHILE size>maxbuf DO BEGIN
BlkWrite(fdo,buf,BlkRead(fdi,buf,maxbuf));
Dec(size,maxbuf);END;
BlkWrite(fdo,buf,BlkRead(fdi,buf,size));
END;
PROCEDURE TxtCopy(VAR fdi,fdo:BFILE;size:LONGINT);
CONST
maxbuf = $2000;
VAR
i : WORD;
buf : array[1..maxbuf] OF BYTE;
BEGIN
WHILE size>maxbuf DO BEGIN
FOR i:=1 TO BlkRead(fdi,buf,maxbuf) DO
IF buf[i]=Ord(^Z) THEN BEGIN BlkWrite(fdo,buf,Pred(i));Exit;END;
BlkWrite(fdo,buf,maxbuf);
Dec(size,maxbuf);END;
FOR i:=1 TO BlkRead(fdi,buf,size) DO
IF buf[i]=Ord(^Z) THEN BEGIN BlkWrite(fdo,buf,Pred(i));Exit;END;
BlkWrite(fdo,buf,size);
END;
FUNCTION BlkOpen(VAR f:BFILE;modes:STRING;s:PathStr):BOOLEAN;
FUNCTION Open1(mode:CHAR):Boolean;
BEGIN
Open1:=FALSE;
WITH f,Regs DO BEGIN
DS:=Seg(s[1]);
DX:=Ofs(s[1]);
CASE mode OF
'I' : BEGIN
AX:=$3D00;
MsDos(Regs);
IF (Flags AND FCarry)<>0 THEN BEGIN
IF AX=4 THEN Error('',FileOpenMaxErMsg);Exit;
END;
END;
'O' : BEGIN
AH:=$3C;
CX:=0;
MsDos(Regs);
IF (Flags AND FCarry)<>0 THEN BEGIN
IF AX=4 THEN Error('',FileOpenMaxErMsg);Exit;
END;
END;
ELSE Exit;END;
Open1 :=TRUE;
OpenFlg:=TRUE;
Handle :=AX;
END;
END;
VAR
i : INTEGER;
BEGIN
s:=s+NUL;
Move(s[1],f.Name,Ord(s[0]));
GetDir(0,f.Path);
BlkOpen:=TRUE;
FOR i:=1 TO Length(modes) DO IF Open1(modes[i]) THEN Exit;
BlkOpen:=FALSE
END;
PROCEDURE SetBTime(VAR f:BFILE;time:LONGINT);
BEGIN
WITH Regs,f DO BEGIN
AX:=$5701;
BX:=Handle;
CX:=Word(time);
DX:=(time AND $FFFF0000) SHR 16;
MsDos(Regs);
END;
END;
PROCEDURE GetBTime(VAR f:BFILE;VAR time:LONGINT);
BEGIN
WITH Regs,f DO BEGIN
AX:=$5700;
BX:=Handle;
MsDos(Regs);
time:=(LONGINT(DX) SHL 16)+CX;
END;
END;
PROCEDURE SetBAttr(VAR f:BFILE;attr:WORD);
VAR
savedir : PathStr;
BEGIN
GetDir(0,savedir);
WITH Regs,f DO BEGIN
ChDir(Path);
AX:=$4301;
DS:=Seg(Name);
DX:=Ofs(Name);
CX:=attr;
MsDos(Regs);END;
ChDir(savedir);
END;
PROCEDURE GetBAttr(VAR f:BFILE;VAR attr:WORD);
VAR
savedir : PathStr;
BEGIN
GetDir(0,savedir);
WITH Regs,f DO BEGIN
ChDir(Path);
AX:=$4300;
DS:=Seg(Name);
DX:=Ofs(Name);
MsDos(Regs);
attr:=CX;END;
ChDir(savedir);
END;
FUNCTION ChkHdr(VAR f:BFILE):BOOLEAN;
VAR
i,chksum : BYTE;
buf : ARRAY[0..256] OF BYTE;
fp : LONGINT;
BEGIN
fp:=BlkFilePos(f);
ChkHdr:=FALSE;
IF BlkRead(f,buf[0],1)=1 THEN
IF BlkRead(f,buf[1],1)=1 THEN
IF buf[0]>=2 THEN
IF BlkRead(f,b